home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / stripper.arc / STRIPPER.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-03-17  |  2.7 KB  |  85 lines
  1. 10   KEY OFF
  2. 20   CLS
  3. 30   DEFINT A-D,W-Z
  4. 40   A=0:B=1:C=2:D=3  'PALET COLORS
  5. 50   CCOLOR=C:BCOLOR=B
  6. 60   BASE$ ="A:\GIRL\"
  7. 70   SCREEN 1
  8. 80   COLOR 0,0
  9. 90   PAINT (1,100),D
  10. 100  RESTORE 660
  11. 110  GOSUB 120:GOTO 110
  12. 120  'DRAWING SUBROUTINE
  13. 130  READ PNTVAL:P=PNTVAL
  14. 140  IF P AND 2048 THEN CLS:PAINT (1,100),D
  15. 150  IF P AND 4096 THEN CLS:GOTO 90
  16. 160  READ CTR
  17. 170  IF P=0 THEN LC=D ELSE LC=A
  18. 180  IF CTR=0 THEN GOTO 260
  19. 190  READ FILE$ : CTR=CTR-1
  20. 200  REM-FILE$=BASE$ + FILE$
  21. 210  OPEN FILE$ FOR INPUT AS #1
  22. 220  IF EOF (1) THEN CLOSE #1: GOTO 180
  23. 230    INPUT#1,W,X,Y,Z
  24. 240    LINE (W,X) -(Y,Z),LC
  25. 250  GOTO 220
  26. 260  IF LC=A THEN GOTO 380
  27. 270  PAINT (1,199),D,A   'CLEAR BOT BACKGROUND
  28. 280  PAINT (1,1) ,D,A    'CLEAR TOP BACKGROUND
  29. 290  PAINT (216,141),D,A 'CLEAR MID BACKGROUND
  30. 300  PAINT (202,120),D,A 'CLEAR BOT CLOTHING
  31. 310  PAINT (184,100),D,D:PAINT (187,100),D,D 'CLEAR RCH
  32. 320  RETURN
  33. 330  'stall
  34. 340  COLOR 8
  35. 350  FOR X=1 TO 6000: NEXT X
  36. 360  COLOR 0
  37. 370  RETURN
  38. 380  'PAINTING SUBROUTINE
  39. 390  PAINT (1,199),BCOLOR,A:PAINT (1,1),BCOLOR,A 'BACKGROUND
  40. 400  IF P AND 1024 GOTO 530
  41. 410  PAINT (216,141),BCOLOR,A 'background mid
  42. 420  IF P AND 1 THEN PAINT (27,150),A,A:PAINT (50,185),A,A 'HAIR
  43. 430  IF P AND 2 THEN PAINT (27,165),CCOLOR,A 'BOW
  44. 440  IF P AND 4 THEN PAINT (60,124),B,A:PAINT (64,144),B,A 'EYES
  45. 450  IF P AND 8 THEN PSET (84,126),C:PAINT (80,125),C,A:PAINT (81,130),C,A:PAINT (85,131),C,A 'LIPS
  46. 460  IF P AND 16 THEN PAINT (100,90),C,A:PAINT (150,92),C,A 'NIPS
  47. 470  IF P AND 32 THEN PAINT (100,90),CCOLOR,A:PAINT (150,92),CCOLOR,A 'TOP
  48. 480  IF P AND 64 THEN PAINT (202,120),CCOLOR,A 'BOT CLOTHING
  49. 490  IF P AND 128 THEN PAINT (184,100),A,A:PAINT (187,100),A,A 'RCH
  50. 500  IF P AND 256 THEN PAINT (280,90),CCOLOR,A:PAINT (255,77),CCOLOR,A 'STKHEAL
  51. 510  IF P AND 512 THEN PAINT (304,108),A,A:PAINT (307,95),A,A:PAINT (295,100),CCOLOR,A 'SHOE
  52. 520  GOTO 330
  53. 530  IF P AND 256 THEN PAINT (275,50),A,A:PAINT (276,100),A,A:PAINT (240,100),A,A:PAINT (259,73),A,A 'heals
  54. 540  IF P AND 128 THEN PAINT (200,90),A,A ' rch
  55. 550  IF P AND 64 THEN PAINT (215,90),C,A:PAINT (237,82),C,A 'vibra
  56. 560  IF P AND 512 THEN PAINT (182,145),BCOLOR,A:PAINT (117,160),BCOLOR,A 'background
  57. 570  P=31:GOTO 420
  58. 580  '
  59. 590  'PNTVAL MEANING:  if zero then delete draw else bits are:
  60. 600  '     1-hair                 16-nips                256-stock heal
  61. 610  '     2-bow                  32-top clothing        512-shoe-PB
  62. 620  '     4-eyes                 64-bot clothing-P     1024-
  63. 630  '     8-lips                128-rch                2048-CLEAR & DRAW
  64. 640  '                   4096-RESTART PROGRAM
  65. 650  '
  66. 660  DATA 879,6,arm,blouse,skirt,dresbelt,dreslegs,head
  67. 670  DATA 0,1,blouse
  68. 680  DATA 96,1,chestbra
  69. 690  DATA 0,2,dresbelt,skirt
  70. 700  DATA 96,5,abdomon,panties,legs,stocking,pntgart
  71. 710  DATA 0,4,pntgart,stocking,abdomon,panties
  72. 720  DATA 352,3,legs,stkgheal,pants
  73. 730  DATA 0,1,chestbra
  74. 740  DATA 96,1,blouse
  75. 750  DATA 0,1,blouse
  76. 760  DATA 80,2,legs,chest
  77. 770  DATA 0,1,pants
  78. 780  DATA 192,3,stocking,gartbelt,rch
  79. 790  DATA 0,2,gartbelt,stocking
  80. 800  DATA 128,3,legs,abdomon,rch
  81. 810  DATA 4096
  82. 820  DATA 3520,4,head,porarmm,porchm,porlegs
  83. 830  DATA 4032,5,head,porarmg,porlegs,porcht,pordyn
  84. 840  DATA 4096
  85.